home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / passb2.f < prev    next >
Text File  |  1989-08-14  |  912b  |  30 lines
  1. *deck passb2
  2.       subroutine passb2 (ido,l1,cc,ch,wa1)
  3. C***BEGIN PROLOGUE  PASSB2
  4. C***REFER TO CFFTB
  5. C***ROUTINES CALLED  (NONE)
  6. C***END PROLOGUE  PASSB2
  7.       dimension       cc(ido,2,l1)           ,ch(ido,l1,2)           ,
  8.      1                wa1(1)
  9. C***FIRST EXECUTABLE STATEMENT  PASSB2
  10.       if (ido .gt. 2) go to 102
  11.       do 101 k=1,l1
  12.          ch(1,k,1) = cc(1,1,k)+cc(1,2,k)
  13.          ch(1,k,2) = cc(1,1,k)-cc(1,2,k)
  14.          ch(2,k,1) = cc(2,1,k)+cc(2,2,k)
  15.          ch(2,k,2) = cc(2,1,k)-cc(2,2,k)
  16.   101 continue
  17.       return
  18.   102 do 104 k=1,l1
  19.          do 103 i=2,ido,2
  20.             ch(i-1,k,1) = cc(i-1,1,k)+cc(i-1,2,k)
  21.             tr2 = cc(i-1,1,k)-cc(i-1,2,k)
  22.             ch(i,k,1) = cc(i,1,k)+cc(i,2,k)
  23.             ti2 = cc(i,1,k)-cc(i,2,k)
  24.             ch(i,k,2) = wa1(i-1)*ti2+wa1(i)*tr2
  25.             ch(i-1,k,2) = wa1(i-1)*tr2-wa1(i)*ti2
  26.   103    continue
  27.   104 continue
  28.       return
  29.       end
  30.